home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu317.dms / pu317.adf / PUBLIC / BBS / BasicProgs / Morse / mors4.0 next >
Text File  |  1990-06-01  |  6KB  |  209 lines
  1. REM REV 1.0 PROGRAM FOR MORSE CODE GENERATION. AUG/86 KMW. PTL.
  2. '  REV 2.0 NUMBERS ADDED 1/87 Kathy Wehr WB3KRN (@ K3RLI for packet mail)
  3. '  REV 4.0 REVISED SPEED FORMULAS & RANDOM CODE 9/20/88 BY W1JT,
  4. '   Emil J.Tanana. Feel free to change characters, timing and format
  5. '   to suit your own style. AmigaBasic lets you do it on the spot!
  6. ' Public Domain Notice: This is FREE ! Don't charge anyone for this 
  7. ' program. If you are a Amateur Radio Operator, send a note with your
  8. ' name, call, & address to Kathy Wehr, RD#1 Box 193, Watsontown, PA
  9. ' 17777 to get receive Amigan Beacon Newsletter, and get info on 
  10. ' AmigaNet, the Low Band Amigan Amateurs Net. If you have comments 
  11. ' or improvements to this program, send them to the above address.
  12. ' I especially welcome comments on how to get the code speed more
  13. ' accurate.
  14. CLEAR
  15. RANDOMIZE TIMER
  16. WIDTH 75
  17.  
  18. TOTAL=.0000001#:WRONG=.0000001#
  19. PRINT"           MORSE CODE GENERATOR.":PRINT :PRINT 
  20. CHANGE:
  21. INPUT"ENTER PITCH OF TONE.(800HZ DEFAULT)";P$
  22. IF P$="" THEN P$="800"
  23. F=VAL(P$) 'sets tone frequency
  24. PRINT :INPUT"ENTER CODE SPEED (DEFAULT=7) WORDS/MINUTE.";WPM$
  25. IF WPM$="" THEN WPM$="7"
  26. WPM=VAL(WPM$)  'sets code speed
  27.  'CALCULATE SPEED, DOT TIME
  28.  IF WPM < 13 THEN CWPM=13 ELSE CWPM =WPM
  29. S=21.84/CWPM  'sets code element timing
  30. IF WPM >= 13 THEN ELE=S ELSE ELE = (43.68 -1.68 * WPM) / WPM
  31. PRINT:INPUT"DO YOU WANT TO RECEIVE MIXED LETTERS,NUMBERS AND PUNCTUATION? (Y/N)";NP$
  32. IF NP$= "" THEN NP$= "Y"
  33. NP$= UCASE$(NP$) 
  34. CHOOSE:
  35. CLS
  36. PRINT"    ENTER:"
  37. PRINT"       C  TO CHANGE SPEED, PITCH AND RECEIVING MODE"
  38. PRINT"       K  FOR KEYBOARD SENDING."
  39. PRINT"       Q  FOR RECEIVING QUIZ."
  40. PRINT"       R  FOR RANDOM RECEIVING PRACTICE."
  41. PRINT"       S  FOR RETURNING TO AMIGADOS."
  42. INPUT R$:R$=UCASE$(R$)
  43. IF R$="C" GOTO CHANGE
  44. IF R$="Q" THEN
  45.   PRINT :PRINT "PRESS ESCAPE KEY TO FOR MENU."
  46.   PRINT"SPEED=";WPM;"WPM. TYPE CHAR SENT; < = AR, > = SK"
  47.   TOTAL=1: WRONG=0: Lno=0
  48.   GOTO QUIZ
  49. END IF  
  50. IF R$="R" THEN
  51.   PRINT:PRINT"PRESS ESCAPE KEY FOR MENU."
  52.   PRINT"SPEED=";WPM;"WPM. 5 CHAR GROUPS; < = AR, > = SK": PRINT
  53.   NGRP=1:GOTO RAND
  54. END IF
  55. IF R$="S" THEN SYSTEM
  56. IF R$="K" THEN
  57.   PRINT :PRINT "START TYPING. PRESS ESCAPE FOR MENU."
  58.   PRINT"SPEED=";WPM;"WPM. CHAR < = AR, > = SK"
  59.   GOTO GETAKEY
  60. END IF  
  61. GOTO CHOOSE
  62.  
  63. GETAKEY:
  64. I$= INKEY$: IF I$="" THEN GETAKEY
  65. I= ASC(I$)
  66. IF I=27 THEN CHOOSE
  67. PRINT I$;
  68. GOSUB 1000
  69. GOTO GETAKEY
  70.  
  71. RAND:
  72. 'I IS THE RANDOM CHARACTER VARIABLE, I$ IS THE LETTER.
  73.  
  74. FOR D=1 TO 5
  75.   IF NP$= "Y" THEN
  76.    I=((INT(RND*47))+44)
  77.    IF I= 58 OR I= 59 THEN I= 45
  78.   ELSE
  79.    I=((INT(RND*43))+48)
  80.    IF I= 58 OR I=59 THEN I=72
  81.   END IF
  82.   IF I=61 THEN I=86 
  83.   IF I=64 THEN I=63
  84.   I$= CHR$(I):PRINT I$;
  85.   GOSUB 1000
  86.   SOUND F,ELE*3,0,0   'CHAR SPACE
  87. NEXT D
  88. SOUND F,ELE*7,0,0   'WORD SPACE
  89.  
  90. PRINT " ";
  91. NGRP=NGRP+1
  92. IF NGRP=13 THEN PRINT: PRINT: NGRP=1  
  93. AN$=UCASE$(INKEY$) 'ROUTINE TO RETURN TO MENU
  94. IF AN$="" THEN RAND ELSE AN=ASC(AN$):IF AN=27 THEN CHOOSE
  95. GOTO RAND
  96.  
  97. QUIZ:
  98. LOCATE 23,1:PRINT"SCORE = ";:PRINT USING "##.##";((100*((TOTAL-WRONG)/TOTAL)));
  99. LOCATE 23,20:PRINT"TOTAL CHAR=";TOTAL;
  100. IF NP$="Y" THEN
  101.  I=((INT(RND*47))+44)
  102.  IF I=58 OR I=59 THEN I = 45
  103. ELSE 
  104.  I=((INT(RND*43))+48)
  105.  IF I= 58 OR I=59 THEN I=86
  106.  
  107. END IF
  108. IF I=61 THEN I=83
  109. IF I=64 THEN I=47
  110. I$=CHR$(I)
  111. SEND:
  112. GOSUB 1000: 
  113. TOTAL = TOTAL+1
  114. Chno = TOTAL-(Lno*70)
  115. ANSWER:
  116. AN$ = UCASE$(INKEY$)
  117. IF AN$ = "" THEN ANSWER
  118. AN = ASC(AN$):IF AN=27 THEN CHOOSE
  119.  
  120. POSITION = Chno 
  121.  
  122. LOCATE 12+Lno,POSITION:PRINT AN$;
  123. IF AN$<>I$ THEN
  124.  WRONG = WRONG+1
  125.  TOTAL = TOTAL-1
  126.  GOTO SEND
  127. END IF 
  128. IF TOTAL = (70+Lno*70) THEN
  129.    PRINT
  130.    Lno = Lno+1
  131. END IF 
  132. GOTO QUIZ
  133.  
  134. 1000 'Code Generator
  135.  C$=CHR$(ASC(I$) OR 32)
  136.  IF C$="a" THEN B$=".-":GOTO 2000
  137.  IF C$="b" THEN B$="-...":GOTO 2000
  138.  IF C$="c" THEN B$="-.-.":GOTO 2000
  139.  IF C$="d" THEN B$="-..":GOTO 2000
  140.  IF C$="e" THEN B$=".":GOTO 2000
  141.  IF C$="f" THEN B$="..-.":GOTO 2000
  142.  IF C$="g" THEN B$="--.":GOTO 2000
  143.  IF C$="h" THEN B$="....":GOTO 2000
  144.  IF C$="i" THEN B$="..":GOTO 2000
  145.  IF C$="j" THEN B$=".---":GOTO 2000
  146.  IF C$="k" THEN B$="-.-":GOTO 2000
  147.  IF C$="l" THEN B$=".-..":GOTO 2000
  148.  IF C$="m" THEN B$="--":GOTO 2000
  149.  IF C$="n" THEN B$="-.":GOTO 2000
  150.  IF C$="o" THEN B$="---":GOTO 2000
  151.  IF C$="p" THEN B$=".--.":GOTO 2000
  152.  IF C$="q" THEN B$="--.-":GOTO 2000
  153.  IF C$="r" THEN B$=".-.":GOTO 2000
  154.  IF C$="s" THEN B$="...":GOTO 2000
  155.  IF C$="t" THEN B$="-":GOTO 2000
  156.  IF C$="u" THEN B$="..-":GOTO 2000
  157.  IF C$="v" THEN B$="...-":GOTO 2000
  158.  IF C$="w" THEN B$=".--":GOTO 2000
  159.  IF C$="x" THEN B$="-..-":GOTO 2000
  160.  IF C$="y" THEN B$="-.--":GOTO 2000
  161.  IF C$="z" THEN B$="--..":GOTO 2000
  162.  IF C$="1" THEN B$=".----":GOTO 2000
  163.  IF C$="2" THEN B$="..---":GOTO 2000
  164.  IF C$="3" THEN B$="...--":GOTO 2000
  165.  IF C$="4" THEN B$="....-":GOTO 2000
  166.  IF C$="5" THEN B$=".....":GOTO 2000
  167.  IF C$="6" THEN B$="-....":GOTO 2000
  168.  IF C$="7" THEN B$="--...":GOTO 2000
  169.  IF C$="8" THEN B$="---..":GOTO 2000
  170.  IF C$="9" THEN B$="----.":GOTO 2000
  171.  IF C$="0" THEN B$="-----":GOTO 2000
  172.  IF C$="." THEN B$=".-.-.-":GOTO 2000
  173.  IF C$="?" THEN B$="..--..":GOTO 2000
  174.  IF C$="," THEN B$="--..--":GOTO 2000
  175.  IF C$="-" THEN B$="-...-":GOTO 2000
  176.  IF C$="/" THEN B$="-..-.":GOTO 2000
  177.  IF I$=" " THEN B$=" ":GOTO 2000
  178.  IF I$=CHR$(8) THEN   'BACKSPACE FOR SENDING ERROR
  179.    B$="........"
  180.    LOCATE ,POS(0)
  181.    PRINT"";
  182.    GOTO 2000
  183.  END IF  
  184.  'IF I$=":" THEN B$="---...":GOTO 2000
  185.  'IF I$=";" THEN B$="-.-.-.":GOTO 2000
  186.  'IF I$="(" OR C$=")" THEN B$="-.--.-":GOTO 2000
  187.  'IF I$="+" OR I$="&" THEN B$=". ...":GOTO 2000
  188.  IF I$=">" THEN B$="...-.-":GOTO 2000  'USE > FOR SK
  189.  IF I$="<" THEN B$=".-.-.":GOTO 2000   'USE < FOR AR
  190.  C$="" :B$="":I$=""
  191.  
  192. 2000 'SOUND ROUTINES
  193.  
  194. FOR E = 1 TO LEN(B$)
  195.   IF MID$(B$,E,1) ="." THEN
  196.     SOUND F,S,200
  197.   ELSEIF MID$(B$,E,1) ="-" THEN
  198.     SOUND F,S*3,200
  199.   ELSE
  200.     SOUND F,ELE*7,0
  201. END IF
  202.  
  203.   SOUND F,ELE,0  'SPACE AFTER DOT OR DASH
  204. NEXT E  'GET THE NEXT DOT OR DASH IN THE CHAR
  205.  
  206.   SOUND F,ELE*3,0  'SPACE AFTER CHAR
  207. RETURN  'GET THE NEXT CHAR
  208. END
  209.